home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 February: Tool Chest / Apple Developer CD Series Tool Chest February 1996 (Apple Computer)(1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / zebu v3.3.3 (LALR parser) / zebu-loader.lisp < prev    next >
Encoding:
Text File  |  1994-09-12  |  18.4 KB  |  487 lines  |  [TEXT/ttxt]
  1. ; -*- mode:     CL -*- ----------------------------------------------------- ;
  2. ; File:         zebu-loader.l
  3. ; Description:  load a ZEBU grammar table
  4. ; Author:       Joachim H. Laubsch
  5. ; Created:       6-Nov-90
  6. ; Modified:     Thu May 12 10:57:29 1994 (Joachim H. Laubsch)
  7. ; Language:     CL
  8. ; Package:      ZEBU
  9. ; Status:       Experimental (Do Not Distribute) 
  10. ; RCS $Header: $
  11. ;
  12. ; (c) Copyright 1990, Hewlett-Packard Company
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; Revisions:
  15. ; RCS $Log: $
  16. ; 13-Jan-93 (Joachim H. Laubsch)
  17. ;  implemented terminal-alist access via the vector terminal-alist-SEQ
  18. ;  5-Nov-91 (Joachim H. Laubsch)
  19. ;  removed dependency on LUCID in the use of backquoted expressions
  20. ;  in semantic actions
  21. ; 16-Jul-91 (Joachim H. Laubsch)
  22. ;  Added a facility to deal with multiple grammars
  23. ;  lr-parse takes a third argument, a grammar
  24. ;  READ-PARSER and LIST-PARSER take a :grammar keyword argument, defaulting to
  25. ;  *current-grammar*
  26. ;  in order to use several grammars we need several 
  27. ;    *IDENTIFIER-CONTINUE-CHARS*, *IDENTIFIER-START-CHARS*
  28. ;    
  29. ;  1-Mar-91 (Joachim H. Laubsch)
  30. ;  did monitoring, found that 75% of the time is in the lexer.
  31. ;  rewrote ZEBU::RECOGNIZE-TOKEN to use a hashtable of terminal-tokens
  32. ;  this sped up this function by a factor of 35. Speed-up of READ-PARSER: 3.5
  33. ; 11-Dec-90 (Joachim H. Laubsch)
  34. ;  Introduce the ZEBU package
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36. (in-package "ZEBU")
  37. (provide "zebu-loader")
  38.  
  39. ;;; The following data structures are loaded from a parse table file by the 
  40. ;;; function which follows.
  41. ;;;
  42. ;;; lexicon is a vector of strings or lisp symbols , indexed by the 
  43. ;;; "grammar symbol indices",  which are the instantiations of
  44. ;;; the grammar symbols.
  45. ;;;
  46. ;;; terminal-indices is a list of the grammar symbol indices indicating
  47. ;;; which among them are terminal symbols.
  48. ;;;
  49. ;;; production-info is a vector, indexed by the production indices.
  50. ;;; Each item is a cons: the cars index the symbols
  51. ;;; which are the lhs of the productions, the cdrs indicate the
  52. ;;; lengths of the productions.
  53. ;;;
  54. ;;; action-table is a vector indexed by the state indices.
  55. ;;; Each state's entry is a vector whose elements represent
  56. ;;; defined entries in the action parsing function. These entries are 3 element
  57. ;;; lists whose first elements are the indices of the grammar symbol argument
  58. ;;; to the action parsing function.  The second elements in the lists are an
  59. ;;; encoding of the action function: 's for shift, 'r for reduce, 'a for
  60. ;;; accept.  The third elements are production or next state indices as
  61. ;;; approprite.  The three element lists appear in their surrounding
  62. ;;; vectors sorted on their cars.
  63. ;;;
  64. ;;; goto-table is arranged similar to action-table but has two element
  65. ;;; lists instead of three.  The second element of each list are the
  66. ;;; index of the state to goto.
  67. ;;; 
  68. ;;; end-symbol-index holds the index of the end symbol.
  69. ;;;
  70. ;;; terminal-alist associates terminal symbol instantiations with
  71. ;;; their indices.
  72. ;;;
  73. ;;; client-lambdas are a vector of procedures, indexed by production index,
  74. ;;; which correspond to productions in the grammar.  The client lambdas are 
  75. ;;; what the parser calls to do syntax directed something by side effect.
  76.  
  77. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78. ;;                             Zebu Grammar Struct
  79. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  80. ;; helps define the function that computes whether a character can continue 
  81. ;; a symbol
  82.  
  83. (defvar *identifier-continue-chars*
  84.   "$-_*.abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890?"
  85.   "Characters that may occur in an identifier. Set this before calling zebu-load-file.")
  86.  
  87. (defvar *identifier-start-chars* "$-*?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
  88.   "Characters that may start an identifier.")
  89.  
  90. ;----------------------------------------------------------------------------;
  91. ; *string-delimiter*, *symbol-delimiter*
  92. ;---------------------------------------
  93. ;; An NLL-constant can now be a string or a symbol. A string is surrounded
  94. ;; by double-quotes (#\"), as in: P(arg1: \"|Jon Doe's Deli|\")
  95. ;; A symbol is surrounded by single-quotes (#\'), as in: 
  96. ;;     P(arg1: 'Jon Doe')
  97. ;; or  P(arg1: '|Jon Doe|')
  98. ;; By default, the single-quotes may be omitted at parsing in case the
  99. ;; symbol contains only characters which are in
  100. ;;    (grammar-identifier-continue-chars *current-grammar*)
  101. ;; as in P(arg1: Jon_Doe)
  102. ;; Either set these variables before the grammar is loaded
  103. ;;   or   supply the initial values explicitely in the .grm file
  104. ;;        e.g. (:name "nll" :string-delimiter #\" :symbol-delimiter #\')
  105. (defvar *string-delimiter* #\"
  106.   "Delimits a lexical token, considered as a STRING.")
  107.  
  108. (defvar *symbol-delimiter* #\'
  109.   "Delimits a lexical token, considered as a SYMBOL.")
  110.  
  111. (defvar *preserve-case* nil
  112.   "If true, the case of an identifier will be preserved (default false).")
  113.  
  114. (defvar *case-sensitive* nil
  115.   "If true, the case of a keyword matters otherwise case is ignored when \
  116. looking for the next token (default false).")
  117.  
  118. (defvar *disallow-packages* nil
  119.   "If false, Zebu parses identifiers as symbols possibly qualified by a package")
  120.     
  121. ;----------------------------------------------------------------------------;
  122. ; grammar
  123. ;--------
  124. ; 
  125. (defstruct (grammar (:print-function print-grammar))
  126.   name
  127.   lexicon
  128.   terminal-indices
  129.   production-info
  130.   action-table
  131.   goto-table
  132.   lr-parser-start-state-index
  133.   end-symbol-index
  134.   client-lambdas
  135.   identifier-index
  136.   string-index
  137.   (number-index nil)
  138.   (identifier-continue-chars     *identifier-continue-chars* :type string)
  139.   (identifier-continue-chars-V   (make-array char-code-limit :element-type 'bit
  140.                          :initial-element 0))
  141.   (identifier-start-chars        *identifier-start-chars* :type string)
  142.   (identifier-start-chars-V      (make-array char-code-limit :element-type 'bit
  143.                          :initial-element 0))
  144.   ;; a vector to be indexed by the char-code of the first character of a key
  145.   ;; each element contains an alist of pairs: (,terminal-token . ,index)
  146.   (terminal-alist-SEQ            (make-sequence 'vector
  147.                         char-code-limit
  148.                         :initial-element nil))
  149.   (case-sensitive                *case-sensitive*)
  150.   (string-delimiter              *string-delimiter* :type character)
  151.   (symbol-delimiter              *symbol-delimiter* :type character)
  152.   file
  153.   (package                       *package*)
  154.   grammar                ; the grammar used to parse the
  155.                     ; grammar being defined
  156.                     ; defaults to the null-grammar
  157.                     ; but you can use the meta-grammar
  158.   (zb-rules ())
  159.   (domain ())
  160.   domain-file
  161.   (lex-cats ())                ; an alist of cateory name and
  162.                     ; regular expressions
  163.   (lex-cat-map ())            ; an alist of index and reg-ex function
  164.   (white-space                  '(#\Space #\Newline #\Tab))
  165.   (intern-identifier            t)    ; Identifier is represented as symbol
  166.   (id-allows-start-digit        nil)    ; An Identifier may start with a digit
  167.   )
  168.  
  169. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  170. ;;                                Null Grammar
  171. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  172. (defvar *NULL-Grammar* (make-grammar :name "null-grammar"))
  173.  
  174. (defun print-grammar (item stream level)
  175.   (declare (ignore level))
  176.   (format stream "<Zebu Grammar: ~A>" (grammar-name item)))
  177.  
  178. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  179. ;;                             register a grammar
  180. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  181. (defvar *all-grammars*
  182.   (list (cons (grammar-name *NULL-Grammar*) *NULL-Grammar*)))
  183.  
  184. (defun find-grammar (name)
  185.   (cdr (assoc (string name) *all-grammars* :test #'equal)))
  186.  
  187. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  188. ;;                            Lexical Analysis Info
  189. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  190. (defvar *identifier-continue-chars-V*)
  191. (declaim (inline identifier-continue-char-p))
  192. (defun identifier-continue-char-p (char)
  193.   (declare (character char))
  194.   (= 1 (sbit *identifier-continue-chars-V* (char-code char))))
  195.  
  196. (defvar *identifier-start-chars-V*)
  197. (declaim (inline identifier-start-char-p))
  198. (defun identifier-start-char-p (char)
  199.   (declare (character char))
  200.   (= 1 (sbit *identifier-start-chars-V* (char-code char))))
  201.  
  202. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  203. ;;                                   Lex-Cats
  204. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  205.  
  206. (declaim (inline add-to-lex-cat-map))
  207. ;; preserve the order of the definition
  208.  
  209. (defun add-to-lex-cat-map (index terminal-token grammar)
  210.   (setf (grammar-lex-cat-map grammar)
  211.     (nconc (grammar-lex-cat-map grammar)
  212.            (list (cons index (symbol-function terminal-token))))))
  213.  
  214. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  215. ;;                               Debugging 
  216. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  217.  
  218. (defvar *grammar-debug* nil
  219.   "If TRUE at compile or load time, the parser emits traces, else not.")
  220.  
  221. (defmacro if-debugging (&rest x)
  222.   `(progn . ,(if *grammar-debug*
  223.          x
  224.            'nil)))
  225.  
  226. (eval-when (compile)
  227.   (setq *grammar-debug* nil))
  228.  
  229. #||
  230. (eval-when (eval)
  231.   (setq *grammar-debug* T))
  232. ||#
  233.  
  234. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  235. ;;         Read in a set of parse tables as written by (dump-tables) .
  236. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  237.  
  238. (defun zebu-load-file (filename &key (verbose t)
  239.                &aux lexicon terminal-indices (*package* *package*))
  240.   ;; returns a grammar and registers this grammar on *all-grammars*
  241.   (let ((path (probe-file (merge-pathnames
  242.                filename
  243.                (merge-pathnames (make-pathname :type "tab")))))
  244.     (*load-verbose* verbose))
  245.     (if path
  246.     (when verbose
  247.       (format t "~%Loading ~s" (namestring path)))
  248.       (error "File not found: ~S" filename))
  249.     (unless (equal (pathname-type path) "tab")
  250.       (let ((name (pathname-name path)))
  251.     (cerror "~S is now compiled."
  252.         "~S is not a Zebu output!~%;;; Compile ~S first!"
  253.         name filename name)
  254.     (setf path (merge-pathnames (make-pathname :type "tab") path)
  255.           filename (namestring path))))
  256.     (with-open-file (port filename :direction :input)
  257.       (let ((options            ; 1: read grammar-options
  258.          (catch 'read-grammar-options
  259.            (check-grammar-options (read port) filename nil))))
  260.     (unless options
  261.       (close port)
  262.       (setq port (open filename :direction :input))
  263.       (setq options
  264.         (catch 'read-grammar-options
  265.           (check-grammar-options (read port) filename nil))))
  266.     (let* ((g (apply #'make-grammar options))
  267.            (terminal-alist-SEQ (grammar-terminal-alist-SEQ g)))
  268.       (declare (type grammar g))
  269.       (prepare-domain (grammar-domain g))
  270.       ;; 1a: load the domain file
  271.       (let ((grammar-domain-file (grammar-domain-file g)))
  272.         (when grammar-domain-file
  273.           (let ((grammar-domain-file-name
  274.              (pathname-name (pathname grammar-domain-file))))
  275.         (or (block find-domain-file
  276.               (dolist (type (append *load-binary-pathname-types*
  277.                         *load-source-pathname-types*))
  278.             (dolist (domain-path (list path (grammar-file g)))
  279.               (let ((domain-file 
  280.                  (merge-pathnames
  281.                   (make-pathname 
  282.                    :name grammar-domain-file-name
  283.                    :type type)
  284.                   domain-path)))
  285.                 (when (probe-file domain-file)
  286.                   (when *load-verbose*
  287.                 (format t "~%Loading domain file ~s"
  288.                     (namestring domain-file)))
  289.                   (return-from find-domain-file
  290.                 (load domain-file)))))))
  291.             (warn "No domain file found")))))
  292.  
  293.       ;; 2: read grammar-lexicon
  294.       (setf (grammar-lexicon g)          (setf lexicon (read port))
  295.         ;; 3: read grammar-terminal-indices
  296.         (grammar-terminal-indices g) (setf terminal-indices (read port))
  297.         ;; 4: read grammar-production-info
  298.         (grammar-production-info g)  (read port))
  299.       (let ((old-grammar (assoc (grammar-name g) *all-grammars*
  300.                     :test #'string=)))
  301.         (if old-grammar
  302.         (setf (cdr old-grammar) g)
  303.           (setf *all-grammars* (acons (grammar-name g) g *all-grammars*))))
  304.     
  305.       ;; 5: read grammar-action-table
  306.       (let ((*package* *ZEBU-PACKAGE*))
  307.         (setf (grammar-action-table g) 
  308.           (vectorize-vector-of-lists (read port))))
  309.     
  310.       ;; 6: read grammar-goto-table
  311.       (setf (grammar-goto-table g) (vectorize-vector-of-lists (read port))
  312.         ;; 7: read grammar-lr-parser-start-state-index
  313.         (grammar-lr-parser-start-state-index g) (read port)
  314.         ;; 8: read grammar-end-symbol-index
  315.         (grammar-end-symbol-index g) (read port)
  316.         ;; 9: read grammar-client-lambdas
  317.         (grammar-client-lambdas g) (read-parser-actions port g))
  318.  
  319.       ;; IDENTIFIER-START-CHARS"
  320.       (let ((identifier-start-chars-V
  321.          (grammar-identifier-start-chars-V g))
  322.         (identifier-start-chars (grammar-identifier-start-chars g)))
  323.         (dotimes (i (length identifier-start-chars))
  324.           (let ((c (schar identifier-start-chars i)))
  325.         (declare (character c))
  326.         (setf (sbit identifier-start-chars-V (char-code c))
  327.               1)
  328.         (when (digit-char-p c)
  329.           (setf (grammar-id-allows-start-digit g) t)))))
  330.  
  331.       ;; IDENTIFIER-CONTINUE-CHARS"
  332.       (let ((identifier-continue-chars-V
  333.          (grammar-identifier-continue-chars-V g))
  334.         (identifier-continue-chars
  335.          (grammar-identifier-continue-chars g)))
  336.         (dotimes (i (length identifier-continue-chars))
  337.           (setf (sbit identifier-continue-chars-V
  338.               (char-code
  339.                (the character
  340.                 (schar identifier-continue-chars i))))
  341.             1)))
  342.  
  343.       ;; sort the terminal-alist so that terminals with the same
  344.       ;; initial string are sorted by decreasing length
  345.       ;; i.e. if "?" and "?u?" are both terminals, then "?u?"
  346.       ;; should be found first.
  347.       ;; This can simply be achieved by sorting according to 
  348.       ;; ascending key length.
  349.       (dotimes (i (length (the simple-vector terminal-indices)))
  350.         (let* ((index (svref terminal-indices i))
  351.            (terminal-token (svref lexicon index)))
  352.           (declare (string terminal-token))
  353.           (typecase terminal-token
  354.         (string
  355.          (let ((char1-code
  356.             (char-code (let ((c (schar terminal-token 0)))
  357.                     (declare (character c))
  358.                     (if (grammar-case-sensitive g)
  359.                     c
  360.                       (char-downcase c)))))
  361.                (token-association `(,terminal-token . ,index)))
  362.            ;; keep a table indexed by char-code of first-char
  363.            ;; of the terminal tokens
  364.            (let ((bucket (elt terminal-alist-SEQ char1-code)))
  365.              (setf (elt terminal-alist-SEQ char1-code)
  366.                (if bucket
  367.                    (sort (cons token-association bucket)
  368.                      #'(lambda (a b) (declare (string a b))
  369.                            (> (length a) (length b)))
  370.                      :key #'car)
  371.                  (list token-association))))))
  372.         (symbol
  373.          (let ((terminal-token-name (symbol-name terminal-token)))
  374.            (declare (string terminal-token-name))
  375.            (cond ((string= terminal-token-name "IDENTIFIER")
  376.               (setf (grammar-identifier-index g) index))
  377.              ((string= terminal-token-name "STRING")
  378.               (setf (grammar-string-index g) index))
  379.              ((string= terminal-token-name "NUMBER")
  380.               (setf (grammar-number-index g) index))
  381.              ;; for lexical categories: remember index
  382.              ((assoc terminal-token (grammar-lex-cats g))
  383.               (add-to-lex-cat-map index terminal-token g))
  384.              (t (warn "If ~S is a terminal it should be a string, not a symbol.~%If it's a non-terminal it's undefined."
  385.                   terminal-token))))))))
  386.       g)))))
  387.  
  388. (defun read-parser-actions (port grammar)
  389.   ;; zb-rules = [(<NT> . <zb-rule>) ...]
  390.   (let ((zb-rules (read port))
  391.     (actions  (make-sequence
  392.            'vector
  393.            (length (grammar-production-info grammar))))
  394.     (actions-idx 1))
  395.     (setf (svref actions 0) :PLACE-HOLDER)
  396.     (dotimes (i (length zb-rules))
  397.       (let ((pair (svref zb-rules i)))
  398.     (let ((zb-rule (cdr pair)))
  399.       (dolist (prod (zb-rule--productions zb-rule))
  400.         (let ((action (production-rhs--build-fn prod)))
  401.           (setf (svref actions actions-idx)
  402.             (if (symbolp action)
  403.             (if (or (eq action 'identity) (null action))
  404.                 nil
  405.               (if (fboundp action)
  406.                   (symbol-function action)
  407.                 (progn
  408.                   (warn "At parse time, ~S should be defined."
  409.                     action)
  410.                   action)))
  411.               action
  412.               ;; (if (fboundp 'compile)
  413.               ;;    (compile nil action)
  414.               ;;   (eval `(function ,action)))
  415.               ))
  416.           (incf actions-idx))))))
  417.     (setf (grammar-zb-rules grammar) zb-rules)
  418.     actions))
  419.  
  420. (defun vectorize-vector-of-lists (V  &aux alist)
  421.   (declare (simple-vector V) (dynamic-extent alist))
  422.   (dotimes (i (length V) V) 
  423.     (let* ((sublist (svref V i))
  424.        (pair (assoc sublist alist :test #'equal)))
  425.       (if pair
  426.       (setf (svref v i) (cdr pair))
  427.     (let ((subV (list->vector sublist)))
  428.       (setf (svref v i) subV)
  429.       (push (cons sublist subV) alist))))))
  430.  
  431.  
  432. ;----------------------------------------------------------------------------;
  433. ; load-from-command-line (for UNIX)
  434. ;----------------------------------
  435. ; Load a compiled grammar from a command line argument:
  436. ;    Zebu-Parser ex1.tab
  437. ; Zebu-Parser <comiled-grammar> -l <file to load before grammar>
  438. ;             -e "<form to be evaluated>"
  439. ;             -quit 
  440. #+LUCID
  441. (defun load-from-command-line ()
  442.   (let ((*default-pathname-defaults*
  443.      (make-pathname :directory
  444.             (pathname-directory (working-directory))))
  445.     (help "Zebu-Parser [-zb] <compiled-grammar> [-l <file>]*
  446.   [-e <form to eval>]*  [-quit]"))
  447.     (handler-case
  448.      (do* ((i 1 (1+ i))
  449.        (arg (command-line-argument i) (command-line-argument i))
  450.        (val (command-line-argument (1+ i))
  451.         (command-line-argument (1+ i))))
  452.       ((null arg)
  453.        (when (= i 1)
  454.          (progn (warn "~a" help) (quit))))
  455.        ;;(format t "~%arg: ~s val: ~s" arg val)
  456.        (cond ((equal arg "-l")
  457.           (incf i) (load val))
  458.          ((equal arg "-e")
  459.           (incf i) (eval (read-from-string val)))
  460.          ((equal arg "-quit") (quit))
  461.          ((equal arg "-h")
  462.           (format t "~%~a" help))
  463.          ((equal arg "-zb")
  464.           (incf i) (zebu-load-file val :verbose t))
  465.          (t (if (probe-file arg)
  466.             (zebu-load-file arg :verbose t)
  467.           (progn
  468.             (warn "Unrecognized argument ~S~%~a" arg help)
  469.             (quit))))))
  470.      (error (c)
  471.         (format t "~&Zebu-Parser failed: ~A~%" c)
  472.         (quit)))))
  473.  
  474. ;----------------------------------------------------------------------------;
  475. ; zebu-load-top
  476. ;--------------
  477. ; interactive loader invocation
  478. ; 
  479. (defun zebu-load-top ()
  480.   (format t "~&Enter the name of a Zebu .tab file to load: ")
  481.   (let ((ifile (read-line t)))
  482.     (zebu-load-file ifile)))
  483.  
  484. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  485. ;;                            End of zebu-loader.l
  486. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  487.